The goal of this vignette is to highlight the power of R and Plotly regarding the visualisation of time series.
library(colorRamps)
library(dplyr)
library(plotly)
library(purrr)
library(MorphoGraphX2R)Some .ply demonstration data coming from my PhD thesis are attached to this package and used here in the vignette. This dataset is a timelapse recording of the development of a WT shoot apical meristem expressing a membrane marker. I took one 3D stack every 12h and have 5 timepoints in total. Here I load the .ply and cell graph .ply for all the timepoints of this timelapse recording.
ply.dir <- system.file("extdata", "normalMesh/", package = "MorphoGraphX2R")
mesh.all <- map(list.files(ply.dir, recursive = TRUE, full.names = TRUE),
~ modified_read.ply(file = .x, ShowSpecimen = FALSE))
#> [1] "Object has 7802 faces and 4180 vertices."
#> [1] "Object has 7689 faces and 4170 vertices."
#> [1] "Object has 6339 faces and 3455 vertices."
#> [1] "Object has 5731 faces and 3137 vertices."
#> [1] "Object has 6147 faces and 3354 vertices."
graph.dir <- system.file("extdata", "cellGraph/", package = "MorphoGraphX2R")
cellGraph.all <- map(list.files(graph.dir, recursive = TRUE, full.names = TRUE), ~modified_read.cellGraph(fileCellGraph = .x, header_max = 30))In plotly, the slider option allows to visualise several graphs linked by a time variable.
meshColors.all <- list(NULL, NULL, NULL, NULL, NULL)
plotlySlider <- function(meshExample,
graphExample,
meshColors,
display,
defaultColor = list("#CCCCFF", 0.2),
heatmapParam = "GeometryArea"
){
makeColorScale <- FALSE
if (display == 'labels'){
opacity <- 1
if (is.null(meshColors)){
meshColors <- meshExample$allColors$Col_label
}
if (ncol(meshColors)>1){
color <- NULL
for (i in 1:ncol(meshColors)){
color[i] <- setdiff(unique(meshColors[,i]), "#000000") #I remove black vertices
} # to be more general, remove any color shared by two vertices
}else{
color <- meshColors
}
} else if (display == 'none'){
color <- rep(defaultColor[[1]], ncol(meshExample$it)) # "#00FFFF"
opacity <- defaultColor[[2]]
} else if (display == 'heatmap'){
if (is.numeric(meshColors) == TRUE && is.null(heatmapParam) == TRUE ){
makeColorScale <- TRUE
colorCut <- cut(pull(meshColors), 15,
labels = matlab.like(15)
)
color <- as.character(colorCut)
opacity <- 1
}else if (is.null(heatmapParam) == FALSE){
meshColors <- left_join(meshExample$it_label, graphExample$vertices) %>%
select_(., heatmapParam)
makeColorScale <- TRUE
colorCut <- cut(pull(meshColors), 15,
labels = matlab.like(15)
)
color <- as.character(colorCut)
opacity <- 1
}else{
warning("Provide continous variable for heatmap or valid heatmap parameter.")
}
}
trace2 <- list(type="mesh3d",
x = meshExample$vb[1,],
y = meshExample$vb[2,],
z = meshExample$vb[3,],
i = meshExample$it[1,]-1, # NB indices start at 0
j = meshExample$it[2,]-1,
k = meshExample$it[3,]-1,
facecolor = color,
opacity = opacity,
visible = FALSE
)
if (makeColorScale){
trace4 <- list(x = c(100,1,200),
y = c(200,1,1),
z = c(1,500,3),
marker = list(
autocolorscale = FALSE,
cmax = round(max(meshColors)),#2.5,
cmin = round(min(meshColors)),#0,
color = c("#0000aa", "#99ff99", "#aa0000"),
colorbar = list(
x = 1.2,
y = 0.5,
len = 1,
thickness = 15,
tickfont = list(size = 12),
titlefont = list(size = 20)
),
colorscale = purrr::map2(.x = seq(0,1, len=15),
.y = matlab.like(15),
~ list(.x, .y)),
line = list(width = 0),
opacity = 0.1,
showscale = TRUE,
size = 20,
symbol = "circle"
),
mode = "markers",
opacity = 0,
type = "scatter3d"
)
}else{
trace4 <- NULL
}
meshCellcenter <- graphExample$vertices[,c("label","x", "y", "z")]
list(trace2, trace4, meshCellcenter)
#facecolor: one color per triangle (e.g. length(facecolor) == length(i))
}
all.trace <- pmap(list(meshExample = mesh.all,
graphExample = cellGraph.all,
meshColors = meshColors.all,
display = 'heatmap'),`plotlySlider`)
all.trace[[1]][[1]]$visible = TRUE
layout <- list(
scene = list(
xaxis = list(
backgroundcolor = "rgb(230,230,230)",
gridcolor = "rgb(255,255,255)",
showbackground = TRUE,
zerolinecolor = "rgb(255,255,255"
),
yaxis = list(
backgroundcolor = "rgb(230,230,230)",
gridcolor = "rgb(255,255,255)",
showbackground = TRUE,
zerolinecolor = "rgb(255,255,255"
),
zaxis = list(
backgroundcolor = "rgb(230,230,230)",
gridcolor = "rgb(255,255,255)",
showbackground = TRUE,
zerolinecolor = "rgb(255,255,255"
)
),
title = "My mesh",
xaxis = list(title = "m[, 1]"),
yaxis = list(title = "m[, 2]")
)
p <- plot_ly()
steps <- list()
for (t in 1:length(all.trace)){
traceCount <- 0
p <- add_trace(p, x=all.trace[[t]][[1]]$x,
y=all.trace[[t]][[1]]$y,
z=all.trace[[t]][[1]]$z,
facecolor=all.trace[[t]][[1]]$facecolor,
i=all.trace[[t]][[1]]$i,
j=all.trace[[t]][[1]]$j,
k=all.trace[[t]][[1]]$k,
type=all.trace[[t]][[1]]$type,
visible = all.trace[[t]][[1]]$visible,
hoverinfo = 'none')
traceCount <- 1
if (!is.null(all.trace[[t]][[2]])){
traceCount <- traceCount+1
p <- add_trace(p,
x = all.trace[[t]][[3]]$x,
y = all.trace[[t]][[3]]$y,
z = all.trace[[t]][[3]]$z,
text = as.character(all.trace[[t]][[3]]$label),
hoverinfo = 'text',
marker = all.trace[[t]][[2]]$marker,
mode = all.trace[[t]][[2]]$mode,
opacity = all.trace[[t]][[2]]$opacity,
type = all.trace[[t]][[2]]$type,
showlegend = FALSE#,
# hoverinfo = 'none'
)
}
if (!is.null(all.trace[[t]][[3]])){ # show cell center
traceCount <- traceCount+1
p <- add_trace(p, x = all.trace[[t]][[3]]$x,
y = all.trace[[t]][[3]]$y,
z = all.trace[[t]][[3]]$z,
text = as.character(all.trace[[t]][[3]]$label),
hoverinfo = 'text',
type = "scatter3d",
mode = "markers",
marker=list(color = 'rgb(255, 255, 255)',
size = 10),
opacity = 0,
showlegend = FALSE
)
}
p <- layout(p, scene=layout$scene, title=layout$title, xaxis=layout$xaxis, yaxis=layout$yaxis)
if (traceCount == 1){
step <- list(args = list('visible', rep(FALSE, length(all.trace))),
method = 'restyle')
step$args[[2]][t] = TRUE
}else if (traceCount == 2){ # slider takes in account all existing traces
step <- list(args = list('visible', rep(FALSE, length(all.trace)*2)),
method = 'restyle')
k <- t + (t-1)
step$args[[2]][k] = TRUE
step$args[[2]][k+1] = TRUE
}else if (traceCount == 3){
step <- list(args = list('visible', rep(FALSE, length(all.trace)*3)),
method = 'restyle')
increment <- seq(0, (length(all.trace)-1)*2, 2)
k <- t + increment[t]
step$args[[2]][k] = TRUE
step$args[[2]][k+1] = TRUE
step$args[[2]][k+2] = TRUE
}
steps[[t]] = step
}
p <- p %>%
layout(sliders = list(list(active = 3,
currentvalue = list(prefix = "Frame: "),
steps = steps)))
p